home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / lang / amigatalk.lha / intuition / Gadget.st < prev    next >
Text File  |  2002-03-27  |  10KB  |  434 lines
  1. "-----------------------------------------------------------------------"
  2. " Gadget Class is an Abstract class for Intuition Gadgets.              "
  3. "-----------------------------------------------------------------------"
  4.  
  5. Class Gadget :Glyph
  6. [
  7.    getGadgetObject   " After all, this is an ABSTRACT CLASS!! "
  8.       super subclassResponsibility: 'getGadgetObject'.
  9.       ^ nil
  10. |
  11.    isDisabled: thisGadget ! gadgetFlags mask !
  12.       gadgetFlags <- GadgetFlags new.
  13.       mask        <- gadgetFlags at: #GFLG_DISABLED.
  14.  
  15.       (mask and: [<primitive 183 2 4 thisGadget>])
  16.          ifTrue: [ ^ true ].
  17.  
  18.       ^ false
  19. |
  20.    isSelected: thisGadget ! gadgetFlags mask !
  21.       gadgetFlags <- GadgetFlags new.
  22.       mask        <- gadgetFlags at: #GFLG_SELECTED.
  23.  
  24.       (mask and: [<primitive 183 2 4 thisGadget>])
  25.          ifTrue: [ ^ true ].
  26.  
  27.       ^ false
  28. |
  29.    "only needed because of GZZGADGET & REQGADGET type flags."
  30.    gadgetTypeIs: thisGadget
  31.       ^ <primitive 183 2 6 thisGadget>
  32. |
  33.    dispose: thisGadget
  34.       <primitive 183 0 thisGadget>.
  35. |
  36.    setStartPoint: thisGadget to: newPoint ! x y !  "newPoint  is leftEdge @ topEdge"
  37.       x <- newPoint x.
  38.       y <- newPoint y.
  39.  
  40.       <primitive 183 3 0 x thisGadget>.
  41.       <primitive 183 3 1 y thisGadget>.
  42. |
  43.    setGadgetSize: thisGadget to: sizePoint ! w h ! "sizePoint is width @ height"
  44.       w <- sizePoint x.
  45.       h <- sizePoint y.
  46.  
  47.       <primitive 183 3 2 w thisGadget>.
  48.       <primitive 183 3 3 h thisGadget>
  49. |
  50.    getStartPoint: thisGadget ! leftEdge topEdge !
  51.       leftEdge <- <primitive 183 2 0 thisGadget>.
  52.       topEdge  <- <primitive 183 2 1 thisGadget>.
  53.  
  54.       ^ leftEdge @ topEdge
  55. |
  56.    getGadgetSize: thisGadget ! width height !
  57.       width  <- <primitive 183 2 2 thisGadget>.
  58.       height <- <primitive 183 2 3 thisGadget>.
  59.  
  60.       ^ width @ height
  61. |
  62.    getGadgetUserData: thisGadget
  63.       ^ <primitive 183 2 19 thisGadget>
  64. |
  65.    setGadgetUserData: thisGadget to: newData
  66.       <primitive 183 3 12 newData thisGadget>
  67. ]
  68.  
  69. "-----------------------------------------------------------------------"
  70. " BoolGadget Class implements messages specific only to boolean gadgets."
  71. "-----------------------------------------------------------------------"
  72.  
  73. Class BoolGadget :Gadget ! private userData !
  74. [
  75.    dispose
  76.       super dispose: private.
  77.  
  78.       ^ nil
  79. |
  80.    isDisabled
  81.       ^ (super isDisabled: private)
  82. |
  83.    isSelected
  84.       ^ (super isSelected: private)
  85. |
  86.    gadgetTypeIs
  87.       ^ (super gadgetTypeIs: private)
  88. |
  89.    "only needed because of GZZGADGET & REQGADGET type flags."
  90.    setGadgetType: newGadgetType
  91.       <primitive 183 3 6 newGadgetType private>
  92. |
  93.    getGadgetObject
  94.       ^ private
  95. |
  96.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  97.       super setStartPoint: private to: newPoint.
  98.  
  99.       ^ newPoint
  100. |   
  101.    setGadgetSizeTo: sizePoint
  102.       super setGadgetSize: private to: sizePoint.
  103.       
  104.       ^ sizePoint
  105. |
  106.    getStartPoint
  107.       ^ (super getStartPoint: private)
  108. |
  109.    getGadgetSize
  110.       ^ (super getGadgetSize: private)
  111. |
  112.    getFlags
  113.       ^ <primitive 183 2 4 private>
  114. |
  115.    setFlags: newFlags
  116.       <primitive 183 3 4 newFlags private>
  117. |
  118.    getActivation
  119.       ^ <primitive 183 2 5 private>
  120. |
  121.    setActivation: newActivation
  122.       <primitive 183 3 5 newActivation private>
  123. |
  124.    getGadgetID
  125.       ^ <primitive 183 2 7 private>
  126. |
  127.    setGadgetID: newGadgetID
  128.       <primitive 183 3 7 newGadgetID private>
  129. |
  130.    getNextGadget
  131.       ^ <primitive 183 2 8 private>
  132. |
  133.    setNextGadget: newNextGadgetObject
  134.       <primitive 183 3 8 newNextGadgetObject private>
  135. |
  136.    getITextString
  137.       ^ <primitive 183 2 9 private>
  138. |
  139.    getGadgetText            " which is an IntuiText Object "
  140.       ^ <primitive 183 2 18 private>
  141. |
  142.    setGadgetText: newIntuiTextObject
  143.       <primitive 183 3 9 newIntuiTextObject private>
  144. |
  145.    getRenderObject
  146.       ^ <primitive 183 2 10 private>
  147. |
  148.    setRender: newRenderObject " Either an Image, Border or IntuiText! "
  149.       <primitive 183 3 10 newRenderObject private>.
  150. |
  151.    getSelectObject
  152.       ^ <primitive 183 2 11 private>
  153. |
  154.    setSelect: newSelectObject " Either an Image, Border or IntuiText! "
  155.       <primitive 183 3 11 newSelectObject private>
  156. |
  157.    getUserData ! rval !
  158.       rval <- super getGadgetUserData: self.
  159.  
  160.       ^ (rval at: 2)
  161. |
  162.    getGadgetValue ! rval !
  163.       rval <- super getGadgetUserData: self.
  164.  
  165.       ^ (rval at: 1)
  166. |
  167.    setUserMethod: methodSymbol
  168.       userData at: 2 put: methodSymbol
  169. |
  170.    new
  171.       private  <- <primitive 183 1>.
  172.       userData <- Array new: 3.
  173.       
  174.       self setGadgetType: 1.
  175.  
  176.       super setGadgetUserData: self to: userData.
  177.       
  178.       ^ self
  179. ]
  180.  
  181. "---------------------------------------------------------------------"
  182. " StrGadget Class implements messages specific only to string gadgets."
  183. "---------------------------------------------------------------------"
  184.  
  185. Class StrGadget :Gadget ! private userData !
  186. [
  187.    dispose
  188.       super dispose: private.
  189.  
  190.       ^ nil
  191. |
  192.    isDisabled
  193.       ^ (super isDisabled: private)
  194. |
  195.    isSelected
  196.       ^ (super isSelected: private)
  197. |
  198.    gadgetTypeIs
  199.       ^ (super gadgetTypeIs: private)
  200. |
  201.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  202.       super setStartPoint: private to: newPoint.
  203.  
  204.       ^ newPoint
  205. |   
  206.    setGadgetSizeTo: sizePoint
  207.       super setGadgetSize: private to: sizePoint.
  208.       
  209.       ^ sizePoint
  210. |
  211.    getStartPoint
  212.       ^ (super getStartPoint: private)
  213. |
  214.    getGadgetSize
  215.       ^ (super getGadgetSize: private)
  216. |
  217.    setBufferSize: newSize
  218.       <primitive 183 5 newSize private>
  219. |
  220.    getBufferSize
  221.       ^ <primitive 183 2 12 private>
  222. |
  223.    getFlags
  224.       ^ <primitive 183 2 4 private>
  225. |
  226.    setFlags: newFlags
  227.       <primitive 183 3 4 newFlags private>
  228. |
  229.    getActivation
  230.       ^ <primitive 183 2 5 private>
  231. |
  232.    setActivation: newActivation
  233.       <primitive 183 3 5 newActivation private>
  234. |
  235.    setGadgetType: newGadgetType
  236.       <primitive 183 3 6 newGadgetType private>.
  237. |
  238.    getGadgetID
  239.       ^ <primitive 183 2 7 private>
  240. |
  241.    setGadgetID: newGadgetID
  242.       <primitive 183 3 7 newGadgetID private>
  243. |
  244.    getNextGadget
  245.       ^ <primitive 183 2 8 private>
  246. |
  247.    setNextGadget: newNextGadgetObject
  248.       <primitive 183 3 8 newNextGadgetObject private>
  249. |
  250.    getITextString
  251.       ^ <primitive 183 2 9 private>
  252. |
  253.    getGadgetText
  254.       ^ <primitive 183 2 18 private>
  255. |
  256.    setGadgetText: newIntuiTextObject
  257.       <primitive 183 3 9 newIntuiTextObject private>
  258. |
  259.    getRender
  260.       ^ <primitive 183 2 10 private>
  261. |
  262.    setRender: newRenderObject " Either an Image or IntuiText! "
  263.       <primitive 183 3 10 newRenderObject private>
  264. |
  265.    getSelect
  266.       ^ <primitive 183 2 11 private>
  267. |
  268.    setSelect: newSelectObject " Either an Image or IntuiText! "
  269.       <primitive 183 3 11 newSelectObject private>
  270. |
  271.    getGadgetObject
  272.       ^ private
  273. |
  274.    getUserData ! rval !
  275.       rval <- super getGadgetUserData: self.
  276.  
  277.       ^ (rval at: 2)
  278. |
  279.    getGadgetValue ! rval !
  280.       rval <- super getGadgetUserData: self.
  281.  
  282.       ^ (rval at: 1)
  283. |
  284.    setUserMethod: methodSymbol
  285.       userData at: 2 put: methodSymbol
  286. |
  287.    new
  288.       private  <- <primitive 183 1>.
  289.       userData <- Array new: 3.
  290.        
  291.       self setGadgetType: 4.
  292.       
  293.       super setGadgetUserData: self to: userData.
  294.       
  295.       ^ self
  296. ]
  297.  
  298. "------------------------------------------------------"
  299. " PropGadget Class implements messages specific only to"
  300. " proportional gadgets.                                "
  301. "------------------------------------------------------"
  302.  
  303. Class PropGadget :Gadget ! private userData !
  304. [
  305.    dispose
  306.       super dispose: private.
  307.  
  308.       ^ nil
  309. |
  310.    isDisabled
  311.       ^ (super isDisabled: private)
  312. |
  313.    isSelected
  314.       ^ (super isSelected: private)
  315. |
  316.    gadgetTypeIs
  317.       ^ (super gadgetTypeIs: private)
  318. |
  319.    "only needed because of GZZGADGET & REQGADGET type flags."
  320.    setGadgetType: newGadgetType
  321.       <primitive 183 3 6 newGadgetType private>
  322. |
  323.    getGadgetObject
  324.       ^ private
  325. |
  326.    setStartPoint: newPoint "newPoint  is leftEdge @ topEdge"
  327.       super setStartPoint: private to: newPoint.
  328.  
  329.       ^ newPoint
  330. |   
  331.    setGadgetSizeTo: sizePoint
  332.       super setGadgetSize: private to: sizePoint.
  333.       
  334.       ^ sizePoint
  335. |
  336.    getStartPoint
  337.       ^ (super getStartPoint: private)
  338. |
  339.    getGadgetSize
  340.       ^ (super getGadgetSize: private)
  341. |
  342.    modifyProps: newFlags hPot: hp vPot: vp hBody: hb
  343.                 vBody: vb window: windowObject
  344.  
  345.       <primitive 183 4 newFlags hp vp hb vb windowObject private>.
  346. |
  347.    setProps: newFlags hPot: hp vPot: vp hBody: hb vBody: vb
  348.  
  349.       <primitive 183 6 newFlags hp vp hb vb private>
  350. |
  351.    getFlags
  352.       ^ <primitive 183 2 4 private>
  353. |
  354.    setFlags: newFlags
  355.       <primitive 183 3 4 newFlags private>
  356. |
  357.    getActivation
  358.       ^ <primitive 183 2 5 private>
  359. |
  360.    setActivation: newActivation
  361.       <primitive 183 3 5 newActivation private>
  362. |
  363.    getGadgetID
  364.       ^ <primitive 183 2 7 private>
  365. |
  366.    setGadgetID: newGadgetID
  367.       <primitive 183 3 7 newGadgetID private>
  368. |
  369.    getNextGadget
  370.       ^ <primitive 183 2 8 private>
  371. |
  372.    setNextGadget: newNextGadgetObject
  373.       <primitive 183 3 8 newNextGadgetObject private>
  374. |
  375.    getITextString
  376.       ^ <primitive 183 2 9 private>
  377. |
  378.    getGadgetText
  379.       ^ <primitive 183 2 18 private>
  380. |
  381.    setGadgetText: newIntuiTextObject
  382.       <primitive 183 3 9 newIntuiTextObject private>
  383. |
  384.    getRender
  385.       ^ <primitive 183 2 10 private>
  386. |
  387.    setRender: newRenderObject " Either an Image or IntuiText! "
  388.       <primitive 183 3 10 newRenderObject private>
  389. |
  390.    getSelect
  391.       ^ <primitive 183 2 11 private>
  392. |
  393.    setSelect: newSelectObject " Either an Image or IntuiText! "
  394.       <primitive 183 3 11 newSelectObject private>
  395. |
  396.    getPropFlags
  397.       ^ <primitive 183 2 13 private>
  398. |
  399.    getHPot
  400.       ^ <primitive 183 2 14 private>
  401. |
  402.    getVPot
  403.       ^ <primitive 183 2 15 private>
  404. |
  405.    getHBody
  406.       ^ <primitive 183 2 16 private>
  407. |
  408.    getVBody
  409.       ^ <primitive 183 2 17 private>
  410. |
  411.    getUserData ! rval !
  412.       rval <- super getGadgetUserData: self.
  413.  
  414.       ^ (rval at: 2)
  415. |
  416.    getGadgetValue ! rval !
  417.       rval <- super getGadgetUserData: self.
  418.  
  419.       ^ (rval at: 1)
  420. |
  421.    setUserMethod: methodSymbol
  422.       userData at: 2 put: methodSymbol
  423. |
  424.    new
  425.       private  <- <primitive 183 1>.
  426.       userData <- Array new: 3.
  427.       
  428.       self setGadgetType: 3.
  429.  
  430.       super setGadgetUserData: self to: userData.
  431.       
  432.       ^ self
  433. ]
  434.